perm filename T[ALS,ALS] blob
sn#176250 filedate 1975-09-08 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00002 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 BEGIN "BOWLS"
00500 C00009 ENDMK
00600 C⊗;
00100 BEGIN "BOWLS"
00200 DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
00300 DEFINE \=" "; $ DEFINE \="SAFE"; $ Simple way to change to SAFE;
00400
00500 INTEGER ARRAY BUF[0:511];
00600 INTEGER I,J,K,L,LENX,SIDEOF,BRCHR,CHAN1,CHAN2,EOF,SIDE;
00700 REAL SCORE,RATING,DELTA;
00800 STRING READ1,READ2,READ3,READX;
00900 BOOLEAN ER;
01000
01100 PROCEDURE NEWNAM; $ Adds a new mname to the list;
01200 ⊂ "NEW"
01300 BUF[I]←CVSIX(READX);
01400 OUTSTR ("Type full name for record = ");
01500 READ1←INCHWL;
01600 I←I+1;
01700 FOR J←1 STEP 5 UNTIL 16 DO
01800 ⊂ BUF[I]←CVASC(READ1[J FOR 5]);
01900 I←I+1;
02000 ⊃ ;
02100 OUTSTR ("Type Apartment number = ");
02200 BUF[I+1]←CVSIX(INCHWL);
02300 OUTSTR ("Type approximate rating = ");
02400 BUF[I+2]←0;
02500 BUF[I+3]←CVD(INCHWL);
02600 ⊃ "NEW";
02700
02800 PROCEDURE MKROOM;
02900 ⊂ FOR K←J STEP 8 UNTIL 504 DO IF BUF[K]=0 THEN DONE;
03000 IF K≥504 THEN OUTSTR("Too many players! ") ELSE
03100 FOR K←K+7 STEP -1 UNTIL I DO BUF[K+8]←BUF[K];
03200 ⊃ ;
03300
03400 PROCEDURE NAME;
03500 ⊂ "NAME" $ Returns index in I for location of nickname;
03600 WHILE TRUE DO
03700 ⊂ "TLOOP"
03800 OUTSTR ("Type NICKNAME = ");
03900 READ1←INCHWL;
04000 IF READ1="" THEN DONE;
04100 IF READ1≥175 THEN DONE;
04200 LENX←LENGTH(READ1);
04300 READX←"";
04400 READX←CVXSTR(CVSIX(READ1));
04500 FOR I←0 STEP 8 UNTIL 511 DO
04600 ⊂ "ILOOP"
04700 IF BUF[I]=0 THEN
04800 ⊂ OUTSTR ("Is this a new nickname? (Y or N) ");
04900 IF INCHWL="Y" THEN
05000 ⊂ MKROOM;
05100 BUF[I]←CVSIX(READX);
05200 NEWNAM;
05300 DONE "TLOOP";
05400 ⊃ ELSE DONE;
05500 ⊃ ;
05600 READ1←CVXSTR(BUF[I])[1 FOR LENX];
05700 IF READX≥READ1 THEN
05800 ⊂ "FOUND"
05900 J←I+8;
06000 IF (J>511)∨(BUF[J]=0) THEN READ2←"ZZZZZ"
06100 ELSE READ2←CVXSTR(BUF[J])[1 FOR LENX];
06200 IF READ1=READ2 THEN
06300 ⊂ OUTSTR ("Ambiguous! type more letters "); DONE "ILOOP";
06400 ⊃ ;
06500 IF READX=READ1 THEN DONE "TLOOP";
06600 IF READX<READ2 THEN
06700 ⊂ "NONE"
06800 OUTSTR ("Is this a new nickname? (Y or N) ");
06900 IF INCHWL="Y" THEN
07000 ⊂ MKROOM;
07100 NEWNAM;
07200 DONE "TLOOP";
07300 ⊃ ELSE
07400 ⊂ FOR K←1 STEP 1 UNTIL LENX DO IF READX[K FOR 1]≠READ1[K FOR 1] THEN DONE;
07500 FOR L←1 STEP 1 UNTIL LENX DO IF READX[L FOR 1]≠READ2[L FOR 1] THEN DONE;
07600 IF K>L THEN
07700 ⊂ OUTSTR ("Do you mean "&READ1&" Y or N? ");
07800 IF INCHWL="Y" THEN
07900 ⊂ READX←READ1;
08000 DONE "TLOOP";
08100 ⊃ ;
08200 ⊃ ;
08300 IF K<L THEN
08400 ⊂ OUTSTR ("Do you mean "&READ2&" Y or N? ");
08500 IF INCHWL="Y" THEN
08600 ⊂ READX←READ2;
08700 I←I+8;
08800 DONE "TLOOP";
08900 ⊃ ;
09000 ⊃ ;
09100 ⊃ ;
09200 ⊃ "NONE";
09300 ⊃ "FOUND";
09400 ⊃ "ILOOP";
09500 OUTSTR ("Try again ");
09600 ⊃ "TLOOP";
09700 ⊃ "NAME";
09800
09900
10000 PROCEDURE UPDATE;
10100 ⊂ WHILE TRUE DO
10200 ⊂ NAME;
10300 IF READX="" THEN DONE;
10400 K←BUF[I+6]+1;
10500 OUTSTR(CVXSTR(BUF[I])&11);
10600 FOR J←I+1 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[J]));
10700 OUTSTR(11&CVS(K)&11);
10800 OUTSTR(11&CVF(BUF[I+5])&" changed to ");
10900 RATING←((BUF[I+5]*3)+DELTA)/4;
11000 OUTSTR(CVF(RATING));
11100 OUTSTR(" Space bar if OK, Return if not ");
11200 IF INCHWL='40 THEN
11300 ⊂ BUF[I+6]←K; BUF[I+5]←RATING;
11400 ⊃ ;
11500 ⊃ ;
11600 ⊃ ;
11700
11800
11900 PROCEDURE CORRECT;
12000 ⊂ "CORRECT"
12100 WHILE TRUE DO
12200 ⊂
12300
12400
12500
12600
12700
12800
12900
13000
13100
13200 NAME; $ Ask for nickname;
13300 IF READX="" THEN DONE;
13400 ⊃ ;
13500 ⊃ "CORRECT";
13600
13700 PROCEDURE REPORT;
13800 ⊂ "REPORT"
13900
14000
14100
14200
14300
14400
14500
14600
14700
14800
14900
15000
15100 ⊃ "REPORT";
15200
15300 PROCEDURE GAME;
15400 ⊂ "GAME"
15500 SETFORMAT(5,3);
15600 WHILE TRUE DO
15700 ⊂ OUTSTR("Type score difference ");
15800 IF (READ1←INCHWL)="" THEN DONE;
15900 DELTA←CVD(READ1);
16000 OUTSTR("Type number on each side");
16100 SIDE←CVD(INCHWL);
16200 DELTA←DELTA/SIDE;
16300 OUTSTR("List winners by nickname ");
16400 UPDATE;
16500 OUTSTR("List losers by nickname ");
16600 UPDATE;
16700 ⊃ ;
16800 ⊃ "GAME";
16900
17000 PROCEDURE NLIST;
17100 ⊂ "NLIST"
17200
17300
17400
17500
17600
17700
17800
17900
18000
18100
18200
18300
18400 ⊃ "NLIST";
18500
18600 PROCEDURE GLIST;
18700 ⊂ "GLIST"
18800
18900
19000
19100
19200
19300
19400
19500
19600
19700 ⊃ "GLIST";
19800
19900 $ MAIN PROGRAM STARTS HERE;
20000
20100 CHAN1←1; CHAN2←2;
20200 CLOSE (CHAN1); OPEN (CHAN1,"DSK",'10,2,0,0,0,EOF);
20300 LOOKUP (CHAN1,"BOWL.DAT[ALS,ALS]",ER);
20400 IF ER THEN OUTSTR ("BOWLD.DAT does not exist.
20500 ") ELSE
20600 ARRYIN(CHAN1,BUF[0],512);
20700 CLOSE(CHAN1);
20800
20900
21000 $ Main program loop starts here;
21100
21200 WHILE TRUE DO
21300 ⊂ OUTSTR
21400 ("Services available are: 0. Exit call. 1. Add game. 2. Add name.
21500 3. Make correction. 4. Ratings. 5. List names. 6. List games.
21600 Type number for service requested = ");
21700 I←0;
21800 I←CVD(INCHWL);
21900 IF (I>6)∨(I≤0) THEN DONE;
22000 CASE I OF ⊂ ;GAME;NAME;CORRECT;REPORT;NLIST;GLIST; ⊃ ;
22100 ⊃ ;
22200 CLOSE (CHAN2); OPEN (CHAN2,"DSK",'10,0,2,0,0,EOF);
22300 ENTER (CHAN2,"BOWL.DAT[ALS,ALS]",ER);
22400 ARRYOUT (CHAN2,BUF[0],512); CLOSE(CHAN2); RELEAS(CHAN2);
22500 ⊃ "BOWLS";